(**
Symbols Used in the APost interpreter and a variant type of things that go on
the stack 
*)
    
type symbol = 
        IntConst of (int * int)
      | StringConst of (string * int)
      | BoolConst of (bool * int)
      | NoneConst of int
      | Add of int
      | Sub of int
      | Mul of int
      | Div of int
      | Mod of int
      | ProcConst of ((symbol list) * int * int)
      | Eq of int
      | Gt of int
      | Lt of int
      | Call of int
      | Get_dict of int
      | Set_dict of int
      | New_dict of int
      | Has_dict of int
      | Print of int
      | Printline of int
      | Tostring of int
      | Loop of int
      | Branch of int
      | Exception of int
      | Return of int
      | New_list of int
      | Head_list of int
      | Tail_list of int
      | Get_list of int
      | Set_list of int
      | Dup of int
      | Load of int
      | Store of int
      | Push_env of int
      | Discard of int
      | Typeof of int
      | Stacksize of int
      | Freeze of int

(* Things that can go on the stack: *)
type varTypes =
    Integer of int
  | String of string
  | Noneval
  (** Procedure (cs, env) is a representation of the procedure with commands cs and parent environment env *)
  | Procedure of (symbol list) * (varTypes, varTypes) Environment.env
  (** FrozenProcedure (cs, env, env', i) represents Procedure(cs, env), frozen at command i with current environment env'*)
  | FrozenProcedure of (symbol list) * (varTypes, varTypes) Environment.env * (varTypes, varTypes) Environment.env * int
  | Dict of (varTypes, varTypes) Hashtbl.t ref
  | Boolean of bool
  | Lst of (varTypes list) ref

(** Get a string representation of a varType instance *)
let rec string_of_varTypes x =
    match x with 
    | Integer i -> string_of_int i;
    | String s -> s
    | Noneval -> "None"
    | Dict tbl -> "{" ^ (Hashtbl.fold (fun k v s -> s ^ (string_of_varTypes k) ^ " : " ^ (string_of_varTypes v) ^ " ," ^ s) !tbl "") ^ "}"
    | Boolean b -> if b then "True" else "False"
    | Procedure (ps,env) -> "<procedure " ^ (string_of_int (List.length ps)) ^ " >"
;;
    
(** This is used to implement exceptions, 
    the parameter is the line number where the exeption was raised *)
exception APostException of int list;;

(** This is used to implement the return command *)
exception APostReturn;;

(** This implements the freeze command, the parameter stores the representation of the system state is it recursively unfolds *)
exception APostFreeze of varTypes;;

let push value (stack : varTypes Stack.t ref)= 
    Stack.push value !stack
;;
(** Raise an exception in the runtime *)
let raise_exception (stack : varTypes Stack.t ref) msg lineno =
    push (String ( msg)) stack;
    raise (APostException [lineno])
    
;;

let pop (stack: varTypes Stack.t ref) c= 
    try 
        Stack.pop !stack
    with Stack.Empty -> raise_exception stack "Stack underflow." c
;;
     
let rec print_stack s = try print_endline (string_of_varTypes (Stack.pop !s)); print_stack s with Stack.Empty -> ()
;;
